perm filename DFUNC.F4[FUN,LCS]3 blob
sn#341648 filedate 1978-03-14 generic text, type T, neo UTF8
C ********** DISPLAY OUTPUT **********
SUBROUTINE DPY(F,IY)
DIMENSION F(1)
IF(IY)GO TO 3
C IY IS TO SUPERIMPOSE WAVES FROM 'CRUNCH'
2 CALL DPYX(IY)
CALL DPYBRT(5)
3 J=F(1)*256.0
I=J+128
CALL AIVECT(-255,I)
DO 1017 K=2,512
I=F(K)*256.0
CALL RVECT(1,I-J)
1017 J=I
CALL DPYOUT(1)
END
SUBROUTINE DPYX(IGRID)
C ON DATADISK GRIDS MUST BE RESEST EACH TIME AROUND.
COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
COMMON FUNC(512),F2(512),K,I
COMMON/DY/IDPY(800),NUMS(5)
DATA NUMS/'1','25','50','75','100'/
CALL DDCLR
C75 CALL CLRPOG(1)
IT=-180
IB=-500
CALL TYPLOC(IT,IB)
CALL DPYSET(1,IDPY,800)
CALL DPYBRT(2)
IF(IGRID.NE.1)GO TO 2
CALL ALINE(256,128,-258,128)
CALL ALINE(-256,-128,-256,384)
10 CALL DPYBIG(6)
CALL DPYTXT(-410,240,FNUM1,1)
CALL DPYOUT(1)
RETURN
C DRAWS GRIDWORK
2 DO 501 K=384,-128,-128
501 CALL ALINE(256,K,-258,K)
DO 502 K=-256,260,128
502 CALL ALINE(K,-130,K,384)
N=-268
CALL DPYBIG(3)
CALL DPYTXT(-285,124,'0',1)
DO 503 K=1,5
CALL DPYTXT(N,388,NUMS(K),1)
503 N=N+128
C NUMBERS OVER GRID
GO TO 10
END
SUBROUTINE PLOTIT(FUNC,EY,P)
COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
DIMENSION FUNC(1)
IF(P.EQ.'P')GO TO 1
IF(P.EQ.0)GO TO 4
Y=1
X=2.
IF(P.NE.'X')GO TO 6
X=1.5
Y=.5
6 CALL PLOTS(K)
P=0
GO TO 40
1 TYPE 2
CALL PLOTS(K)
ACCEPT 3,X
IF(X.EQ.0)X=SZX
IF(X.EQ.0)X=1.
SZX=X
40 SZ=X/5.12
S=0
J=1
JK=X*3
CALL SYMBOL(SZ,4.*SZ,JK,0,FLNM,5)
4 CALL SYMBOL(SZ,-3.*SZ,JK,0,B(2,JX),3)
CALL PLOT(5.12*SZ,0.,3)
CALL PLOT(0.,0.,2)
CALL PLOT(0.,-2.*SZ,3)
CALL PLOT(0.,2.*SZ,2)
72 CALL PLOT(.01*SZ,FUNC(1)*2.*SZ,3)
DO 73 K=2,512
R=K/100.0
73 CALL PLOT(R*SZ,FUNC(K)*2.*SZ,2)
T=0
Q=Y+5*SZ
IF(J.NE.5)GO TO 5
Q=-S
T=-7*SZ
5 CALL PLOT(Q,T,-3)
S=S+Q
J=J+1
2 FORMAT(' TYPE SIZE - '$)
3 FORMAT(F)
END